perm filename INIO.FAI[NEW,LCS] blob
sn#592303 filedate 1981-06-06 generic text, type T, neo UTF8
00100 TITLE INIO ;
00500 INTERNAL PUTEXT,EXTOUT,GETEXT,EXTIN,FINEXT
00600 ; WRITES AND READS DUMP MODE FILES WITH ANY EXTENSION.
00700 ENTRY TYPWRD,TYPSTR,TYPINT,TYPCRLF,TYPFLT,TYPCHR
00800 ;TYPES A WORD, STRING, CRLF, INTEGER, FLTING PT., TYPE CHAR STRING(WD CNT)
00900
01000
01100 CH3←13 ;USED WITH GETFI2, LOOKL
01200 CH1←15 ;USED WITH ALL 'LOOK' ROUTINES
01300 CH←12 ;USED WITH EXTIN
01400 CH2←11 ;USED WITH EXTOUT
01500 BLKS←←=1
01600
02500
02600
02700 DEFINE ERROR (MSG)
02800 < JSA 16,.ERROR
02900 JUMP [ASCIZ/MSG/
03000 ]
03100 >
03200
03300
03400 REGS: BLOCK 20
03500 DIR: BLOCK 4
03600
03700 ;CALL PUTEXT(<FILE>,<EXT>)
03800 PUTEXT: 0 ;USES EXTOUT,FINEXT, CH2
03900 MOVE 0,@0(16)
04000 MOVEM 0,FILNAM
04100 MOVE 0,@1(16)
04200 MOVEM 0,EXTNAM
04300 PUSHJ 17,INTFIL
04400 SETZM DIR+2
04500 SETZM DIR+3
04600 ENTER CH2,DIR
04700 ERROR <ENTER FAILED>
04800 JRA 16,2(16)
04900
05000 ;CALL EXTOUT(<ARRAY>,<NO. OF WORDS>)
05100
05200 EXTOUT: 0
05300 MOVEI 0,@(16)
05400 SUBI 0,1
05500 MOVEM 0,COM
05600 MOVN 0,@1(16)
05700 HRLM 0,COM
05800 OUTPUT CH2,COM
05900 STATZ CH2,740000
06000 ERROR <WRITE ERROR>
06100 JRA 16,2(16)
06200
06300
06400 INTFIL: MOVEI REGS ; INITS DSK
06500 BLT REGS+3
06600 INIT CH2,17
06700 SIXBIT/DSK/
06800 0
06900 ERROR <CAN'T INIT DSK!>
07000 INTF4: MOVE 0,FILNAM#
07100 MOVEM 0,FN#
07200 MOVE 1,[POINT 7,FN]
07300 INTF3: MOVE 2,[POINT 6,DIR]
07400 SETZM DIR
07500 MOVEI 3,5
07600 INTF1: ILDB 0,1
07700 CAIN 0," "
07800 JRST INTF2
07900 SUBI 0,40
08000 IDPB 0,2
08100 SOJG 3,INTF1
08200 INTF2: HRLZI REGS
08300 BLT 3
08400 MOVE 0,EXTNAM#
08500 MOVEM 0,EX#
08600 MOVE 1,[POINT 7,EX]
08700 EXTF3: MOVE 2,[POINT 6,DIR+1]
08800 SETZM DIR+1
08900 MOVEI 3,5
09000 EXTF1: ILDB 0,1
09100 CAIN 0," "
09200 JRST EXTF2
09300 SUBI 0,40
09400 IDPB 0,2
09500 SOJG 3,EXTF1
09600 EXTF2: HRLZI REGS
09700 BLT 3
09800 POPJ 17,
09900
10000
10100 COM: OCT 0,0
10200 BLKNUM: 0
10300
10400 ;CALL FINEXT
10500 FINEXT: 0
10600 CLOSE CH2,0
10700 STATZ CH2,740000
10800 ERROR <ERROR AFTER CLOSE>
10900 RELEASE CH2,0
11000 JRA 16,0(16)
11100
11200 ;CALL GETEXT(<FILE>,<EXT>)
11300
11400 GETEXT: 0 ;USES CH
11500 SETZM GETCH# ;FLAG TO USE CH
11600 MOVE 0,@0(16)
11700 MOVEM 0,FILNAM
11800 MOVE 0,@1(16)
11900 MOVEM 0,EXTNAM
12000 PUSHJ 17,INTFX
12100 SETZM DIR+3
12200 SETZM DIR+2
12300 LOOKUP CH,DIR
12400 ERROR <LOOKUP FAILED>
12500 JRA 16,2(16)
12600
12700 INTFX: PUSHJ 17,INITCH
12800 JRST INTF4
12900
13000 INITCH: MOVEI REGS ;INITS DSK FOR INPUT
13100 BLT REGS+3
13200 SKIPE GETCH ;SKIP IF DOING GETEXT
13300 JRST GETLK
13400 INIT CH,17
13500 SIXBIT/DSK/
13600 0
13700 ERROR <CAN'T INIT DSK!>
13800 POPJ 17,
13900 GETLK: INIT CH1,17
14000 SIXBIT/DSK/
14100 0
14200 ERROR <CAN'T INIT DSK!>
14300 POPJ 17,
14400
14500
14600 ;CALL FASTI2(<ARRAY>,<NO. WORDS>)
14700
14800 EXTIN: 0
14900 MOVEI 0,@(16)
15000 SUBI 0,1
15100 MOVEM 0,COM
15200 MOVN 0,@1(16)
15300 HRLM 0,COM
15400 INPUT CH,COM
15500 STATZ CH,740000
15600 0
15700 JRA 16,2(16)
15800 .ERROR: 0
15900 OUTSTR [ASCIZ/?
16000 /] ;MAKE SURE HE CAN SEE HIS ERROR
16100 OUTSTR @(16) ;OUTPUT ERROR MESSAGE
16200 CALLI 1,12 ;LET USER CONTINUE
16300 JRA 16,1(16)
16400 ;CALL GETFI2(<FILE>,<0 OR -1>) 0=DAT,LCS -1=WHERE YOU ARE., -2=MSS,MUS(HELP)
16500
16600 GETFI2: 0 ; USES CH3
16700 MOVE 0,@0(16)
16800 MOVEM 0,FILNAM
16900 MOVE 0,@1(16)
17000 MOVEM 0,PPNW#
17100 PUSHJ 17,INTFIZ
17200 MOVE 0,[SIXBIT/DMD/]
17300 MOVEM 0,DIR+1
17400 GETFL: JSA 16,LKUP
17500 SKIPA
17600 JRST GETF3
17700 SETZM DIR+1
17800 JSA 16,LKUP
17900 SKIPA
18000 GETF3: JRA 16,2(16)
18100 MOVEI 1
18200 MOVEM @1(16) ;SEND BACK A 1 IN 2ND ARGUMENT IF FILE NOT FOUND.
18300 JRA 16,2(16)
18400
18500 LKUP: 0
18600 SETZM DIR+2
18700 SETZM DIR+3
18800 SKIPE PPNW ;0=DAT,LCS NON-ZERO = WHERE EVER YOU ARE
18900 JRST LUP
19000 MOVE 0,[SIXBIT/DATLCS/]
19100 JRST LUP3
19200 LUP: MOVN 0,PPNW
19300 CAIE 0,2 ;-2=MSS,MUS
19400 JRST LUP2
19500 MOVE 0,[SIXBIT/MSSMUS/]
19600 LUP3: MOVEM 0,DIR+3 ;PUTS AWAY THE PPN
19700 LUP2: LOOKUP CH3,DIR
19800 JRA 16,0(16)
19900 JRA 16,1(16)
20000
20100 INTFIZ: MOVEI REGS ;INITS DSK FOR INPUT
20200 BLT REGS+3
20300 INIT CH3,17
20400 SIXBIT/DSK/
20500 0
20600 ERROR <CAN'T INIT DSK!>
20700 JRST INTF4
09900 TYPSTR: 0 ;CALL TYPSTR(STRING)
10000 OUTSTR @(16) ;TYPES OUT A STRING
10100 JRA 16,1(16) ;THIS WILL TYPE IN GROUPS OF 5 CHARS ALWAYS!!!
10200
10300 TYPCHR: 0 ;CALL TYPCHR(STRING,CHAR COUNT)
10400 SKIPL 1,@1(16)
10500 JRST TYPCH2
10600 OUTSTR @(16)
10700 TYPCH1: JRA 16,2(16)
10800 TYPCH2: MOVSI 2,440700
10900 HRRI 2,@(16)
11000 TYPCH3: SOJL 1,TYPCH1
11100 ILDB 3,2
11200 OUTCHR 3
11300 JRST TYPCH3
11400
11500 TYPWRD: 0 ;CALL TYPWRD(WORD) ASSUMES ≤5 CHARS.
11600 MOVSI 2,440700
11700 HRRI 2,@(16)
11800 MOVEI 1,5
11900 TYPWR1: ILDB 3,2
12000 OUTCHR 3
12100 SOJG 1,TYPWR1
12200 JRA 16,1(16)
12300
12400 TYPCRLF: 0 ;CALL TYPCRLF TYPES A CRLF
12500 OUTSTR [ASCIZ /
12600 /]
12700 JRA 16,(16)
12800
12900 TYPINT: 0 ;CALL TYPINT(INTEGER)
13000 SKIPGE 1,@(16) ;TYPES OUT INTEGERS
13100 OUTCHR ["-"]
13200 MOVMS 1
13300 PUSHJ 17,DECREC
13400 JRA 16,1(16)
13500 DECREC: IDIVI 1,=10
13600 HRLM 2,(17)
13700 SKIPE 1
13800 PUSHJ 17,DECREC
13900 HLRZ 1,(17)
14000 ADDI 1,"0"
14100 OUTCHR 1
14200 POPJ 17,
14300
14400 TYPFLT: 0 ;CALL TYPFLT(F)
14500 MOVM 4,@(16) ;NEEDS ACS 1→5 **** PRINTS ONLY TO 2 DECIS.
14600 KIFIX 3,@(16)
14700 FMPR 4,[100.0] ;TO GET THINGS TO RT. OF DEC.
14800 ;;*** CAUSES 199.997 TO PRINT AS 199 ** FADR 4,[0.5] ;FOR ROUND OFF.
14900 KIFIX 4,4
15000 IDIVI 4,=100 ;REMAINDER IS IN AC6
15100 JUMPN 3,TYPFL1 ;JUMP IF LFT SIDE .NE.0
15200 SKIPGE @(16) ;IS ORIGINAL NUM. NEG?
15300 OUTCHR ["-"] ;YES
15400 OUTCHR ["0"]
15500 JRST .+3 ;PRINT A ZERO AND SKIP NEXT CALL
15600 TYPFL1: JSA 16,TYPINT
15700 JUMP 3
15800 SKIPN 5 ;PRINT NO MORE IF ONLY ZEROS
15900 JRA 16,1(16)
16000 OUTCHR ["."] ;DECIMAL PT.
16100 ;; CAIGE 5,=100
16200 ;; OUTCHR["0"] ;FOR ZERO AFTER DECI
16300 CAIGE 5,=10
16400 OUTCHR["0"] ;FOR ZERO AFTER DECI
16500 ;; MOVE 3,5
16600 ;; IDIVI 3,=100
16700 ;; JUMPE 4,DECI ;LOOK AT REMAINDER, JUMP IF NON-ZERO
16800 MOVE 3,5
16900 IDIVI 3,=10
17000 SKIPE 4 ;LOOK AT REMAINDER, JUMP IF NON-ZERO
17100 MOVE 3,5 ;ELSE PRINT ALL 3 DIGITS
17200 DECI: JSA 16,TYPINT
17300 JUMP 3
17400 JRA 16,1(16)
17500
17600 END